home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s3.arc / PIBMENUS.MOD < prev    next >
Text File  |  1987-05-04  |  43KB  |  907 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           PIBMENUS.PAS   --- Menu Routines for Turbo Pascal          *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*                                                                      *)
  7. (*  Date:    Version 1.0: January, 1985                                 *)
  8. (*           Version 1.1: March, 1985                                   *)
  9. (*           Version 1.2: May, 1985                                     *)
  10. (*           Version 2.0: June, 1985                                    *)
  11. (*           Version 2.1: July, 1985                                    *)
  12. (*           Version 3.0: October, 1985                                 *)
  13. (*           Version 3.2: November, 1985                                *)
  14. (*           Version 4.0: March, 1986                                   *)
  15. (*           Version 4.1: February, 1987                                *)
  16. (*           Version 4.2: March, 1987                                   *)
  17. (*                                                                      *)
  18. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  19. (*                                                                      *)
  20. (*  History: These routines represent my substantial upgrading of the   *)
  21. (*           simple menu routines written by Barry Abrahamsen which     *)
  22. (*           I believe appeared originally in the TUG newsletter.       *)
  23. (*           The windowing facility provides windows similar to those   *)
  24. (*           implemented in QMODEM by John Friel III.                   *)
  25. (*                                                                      *)
  26. (*           Version 2.0 of these adds the exploding windows feature    *)
  27. (*           as well the use-selectable box-drawing characters.         *)
  28. (*           The exploding box algorithm is derived from one by         *)
  29. (*           Jim Everingham.                                            *)
  30. (*                                                                      *)
  31. (*           Note that the routines present in PIBSCREN.PAS were        *)
  32. (*           originally part of the PIBMENUS.PAS file.  With version    *)
  33. (*           2.0 of PibMenus, PIBMENUS.PAS is split into the screen-    *)
  34. (*           handling routines in PIBSCREN.PAS and the actual menu      *)
  35. (*           routines in PIBMENUS.PAS.                                  *)
  36. (*                                                                      *)
  37. (*           Suggestions for improvements or corrections are welcome.   *)
  38. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  39. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  40. (*                                                                      *)
  41. (*           If you use this code in your own programs, please be nice  *)
  42. (*           and give all of us credit.                                 *)
  43. (*                                                                      *)
  44. (*----------------------------------------------------------------------*)
  45. (*                                                                      *)
  46. (*  Needs:  These routines need the include files MINMAX.PAS,           *)
  47. (*          GLOBTYPE.PAS, ASCII.PAS, and PIBSCREN.PAS. These files      *)
  48. (*          are not included here, since Turbo Pascal regrettably does  *)
  49. (*          not allow nested includes.                                  *)
  50. (*                                                                      *)
  51. (*----------------------------------------------------------------------*)
  52. (*                                                                      *)
  53. (*  What these routines do:                                             *)
  54. (*                                                                      *)
  55. (*    These routines provide a straight-forward menu-selection          *)
  56. (*    facility, similar to that used in programs like Lotus.  A pop-up  *)
  57. (*    window holds the menu.  The menu is contained in a frame.  The    *)
  58. (*    items are displayed within the frame.  The currently selected     *)
  59. (*    item is highlighted in reverse video.  You move up and down in    *)
  60. (*    the list of menu items by using the up and down arrow keys, or    *)
  61. (*    the space bar.  To make a selection, hit the Enter (Return) key.  *)
  62. (*                                                                      *)
  63. (*    Alternatively, you may hit the first character of a menu item.    *)
  64. (*    The first menu item found with that initial letter is selected.   *)
  65. (*                                                                      *)
  66. (*    The characters comprising the menu box are user-selectable.       *)
  67. (*    In addition, menus may just "pop up" onto the screen, or may      *)
  68. (*    "explode" onto the screen.                                        *)
  69. (*                                                                      *)
  70. (*    Hitting the escape key causes a menu choice of "-1" to be         *)
  71. (*    returned to the calling routine.                                  *)
  72. (*                                                                      *)
  73. (*----------------------------------------------------------------------*)
  74. (*                                                                      *)
  75. (*  Use:                                                                *)
  76. (*                                                                      *)
  77. (*     (1)  Define a variable of type Menu_Type, say, MYMENU.           *)
  78. (*                                                                      *)
  79. (*     (2)  Define the following entries in MYMENU:                     *)
  80. (*                                                                      *)
  81. (*             Menu_Size    --- Number of entries in this menu          *)
  82. (*             Menu_Title   --- Title for the menu                      *)
  83. (*             Menu_Row     --- Row where menu should appear (upper LHC *)
  84. (*             Menu_Column  --- Column where menu should appear         *)
  85. (*             Menu_Width   --- Width of menu                           *)
  86. (*             Menu_Height  --- Height of menu                          *)
  87. (*             Menu_Default --- Ordinal of the default menu entry       *)
  88. (*             Menu_Tcolor  --- Color to display menu text              *)
  89. (*             Menu_Bcolor  --- Color for menu background               *)
  90. (*             Menu_Fcolor  --- Color for menu frame box                *)
  91. (*                                                                      *)
  92. (*     (3)  Now for each of Menu_Size Menu_Entries, define:             *)
  93. (*             Menu_Text   --- Text of menu item                        *)
  94. (*                                                                      *)
  95. (*     (4)  Optionally call  Menu_Set_Box_Chars  to define the          *)
  96. (*          characters used to form the menu box.                       *)
  97. (*                                                                      *)
  98. (*     (5)  Optionally call Menu_Set_Explode to set the menus as either *)
  99. (*          exploding or pop-up.                                        *)
  100. (*                                                                      *)
  101. (*     (6)  Optionally call Menu_Set_Beep to turn beeping on/off.       *)
  102. (*                                                                      *)
  103. (*     (7)  Call  Menu_Display_Choices  to display menu.  The default   *)
  104. (*          menu choice will be highlighted.                            *)
  105. (*                                                                      *)
  106. (*     (8)  Call  Menu_Get_Choice  to retrieve menu choice.  The up and *)
  107. (*          down arrows, and the space bar, can be used to move         *)
  108. (*          through the menu items.  Each item is highlighted in turn.  *)
  109. (*          Whichever item is highlighted when a carriage return is     *)
  110. (*          entered is returned as the chosen item.                     *)
  111. (*                                                                      *)
  112. (*----------------------------------------------------------------------*)
  113.  
  114. PROCEDURE Menu_Set_Explode( Explode_ON : BOOLEAN );
  115.  
  116. (*----------------------------------------------------------------------*)
  117. (*                                                                      *)
  118. (*     Procedure:  Menu_Set_Explode                                     *)
  119. (*                                                                      *)
  120. (*     Purpose:    Turn exploding menus on or off                       *)
  121. (*                                                                      *)
  122. (*     Calling Sequence:                                                *)
  123. (*                                                                      *)
  124. (*        Menu_Set_Explode( Explode_ON : BOOLEAN );                     *)
  125. (*                                                                      *)
  126. (*           Explode_ON --- TRUE to use exploding menus,                *)
  127. (*                          FALSE to use pop-up menus                   *)
  128. (*                                                                      *)
  129. (*     Calls:   None                                                    *)
  130. (*                                                                      *)
  131. (*----------------------------------------------------------------------*)
  132.  
  133. BEGIN (* Menu_Set_Explode *)
  134.  
  135.    Menu_Explode_Mode := Explode_ON;
  136.  
  137. END   (* Menu_Set_Explode *);
  138.  
  139. (*----------------------------------------------------------------------*)
  140. (*               Menu_Set_Beep --- Set beep mode on or off              *)
  141. (*----------------------------------------------------------------------*)
  142.  
  143. PROCEDURE Menu_Set_Beep( Beep_ON : BOOLEAN );
  144.  
  145. (*----------------------------------------------------------------------*)
  146. (*                                                                      *)
  147. (*     Procedure:  Menu_Set_Beep                                        *)
  148. (*                                                                      *)
  149. (*     Purpose:    Turn beeping (errors, etc.) on or off                *)
  150. (*                                                                      *)
  151. (*     Calling Sequence:                                                *)
  152. (*                                                                      *)
  153. (*        Menu_Set_Beep( Beep_ON : BOOLEAN );                           *)
  154. (*                                                                      *)
  155. (*           Beep_ON --- TRUE to allow beeps,                           *)
  156. (*                       FALSE to disallow beeps.                       *)
  157. (*                                                                      *)
  158. (*     Calls:   None                                                    *)
  159. (*                                                                      *)
  160. (*----------------------------------------------------------------------*)
  161.  
  162. BEGIN (* Menu_Set_Beep *)
  163.  
  164.    Menu_Beep_Mode := Beep_ON;
  165.  
  166. END   (* Menu_Set_Beep *);
  167.  
  168. (*----------------------------------------------------------------------*)
  169. (*     Menu_Set_Box_Chars --- Set box drawing characters for menus      *)
  170. (*----------------------------------------------------------------------*)
  171.  
  172. PROCEDURE Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;
  173.                               Top_Line            : CHAR;
  174.                               Top_Right_Corner    : CHAR;
  175.                               Right_Line          : CHAR;
  176.                               Bottom_Right_Corner : CHAR;
  177.                               Bottom_Line         : CHAR;
  178.                               Bottom_Left_Corner  : CHAR;
  179.                               Left_Line           : CHAR  );
  180.  
  181. (*----------------------------------------------------------------------*)
  182. (*                                                                      *)
  183. (*     Procedure:  Menu_Set_Box_Chars                                   *)
  184. (*                                                                      *)
  185. (*     Purpose:    Set box characters for drawing menu boxes            *)
  186. (*                                                                      *)
  187. (*     Calling Sequence:                                                *)
  188. (*                                                                      *)
  189. (*        Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;               *)
  190. (*                            Top_Line            : CHAR;               *)
  191. (*                            Top_Right_Corner    : CHAR;               *)
  192. (*                            Right_Line          : CHAR;               *)
  193. (*                            Bottom_Right_Corner : CHAR;               *)
  194. (*                            Bottom_Line         : CHAR;               *)
  195. (*                            Bottom_Left_Corner  : CHAR;               *)
  196. (*                            Left_Line           : CHAR  );            *)
  197. (*                                                                      *)
  198. (*           --- arguments are what their names suggest.                *)
  199. (*                                                                      *)
  200. (*                                                                      *)
  201. (*     Calls:   None                                                    *)
  202. (*                                                                      *)
  203. (*----------------------------------------------------------------------*)
  204.  
  205. BEGIN (* Menu_Set_Box_Chars *)
  206.  
  207.    Menu_Box_Chars.Top_Left_Corner     := Top_Left_Corner;
  208.    Menu_Box_Chars.Top_Line            := Top_Line;
  209.    Menu_Box_Chars.Top_Right_Corner    := Top_Right_Corner;
  210.    Menu_Box_Chars.Right_Line          := Right_Line;
  211.    Menu_Box_Chars.Bottom_Right_Corner := Bottom_Right_Corner;
  212.    Menu_Box_Chars.Bottom_Line         := Bottom_Line;
  213.    Menu_Box_Chars.Bottom_Left_Corner  := Bottom_Left_Corner;
  214.    Menu_Box_Chars.Left_Line           := Left_Line;
  215.  
  216. END   (* Menu_Set_Box_Chars *);
  217.  
  218. (*----------------------------------------------------------------------*)
  219. (*                      Draw_Box --- Draw a box                         *)
  220. (*----------------------------------------------------------------------*)
  221.  
  222. PROCEDURE Draw_Box( X1, Y1, X2, Y2 : INTEGER;
  223.                     Frame_Color    : INTEGER;
  224.                     Title_Color    : INTEGER;
  225.                     Title          : AnyStr   );
  226.  
  227. VAR
  228.    I     : INTEGER;
  229.    LT    : INTEGER;
  230.    FColor: INTEGER;
  231.  
  232. BEGIN (* Draw_Box *)
  233.  
  234.    LT     := LENGTH( Title );
  235.    FColor := Frame_Color;
  236.  
  237.    IF LT > 0 THEN
  238.       BEGIN
  239.          WriteSXY( Menu_Box_Chars.Top_Left_Corner + '[ ',
  240.                    X1, Y1, FColor );
  241.          WriteSXY( Title, X1 + 3, Y1, Title_Color );
  242.          WriteSXY( ' ]', X1 + LT + 3, Y1, FColor );
  243.       END
  244.    ELSE
  245.       WriteSXY( Menu_Box_Chars.Top_Left_Corner +
  246.                 DUPL( Menu_Box_Chars.Top_Line , 4 ), X1, Y1, FColor );
  247.  
  248.                                    (* Draw remainder of top of frame *)
  249.  
  250.    WriteSXY( Dupl( Menu_Box_Chars.Top_Line , X2 - X1 - LT - 5 ),
  251.              ( X1 + LT + 5 ), Y1, FColor );
  252.  
  253.    WriteCXY( Menu_Box_Chars.Top_Right_Corner, X2, Y1, FColor );
  254.  
  255.                                   (* Draw sides of frame *)
  256.  
  257.    FOR I := SUCC( Y1 ) TO PRED( Y2 ) DO
  258.       BEGIN
  259.          WriteCXY( Menu_Box_Chars.Left_Line,  X1, I, FColor );
  260.          WriteCXY( Menu_Box_Chars.Right_Line, X2, I, FColor );
  261.       END;
  262.                                   (* Draw bottom of frame     *)
  263.  
  264.    WriteCXY( Menu_Box_Chars.Bottom_Left_Corner, X1, Y2, FColor );
  265.  
  266.    WriteSXY( Dupl( Menu_Box_Chars.Bottom_Line , PRED( X2 - X1 ) ),
  267.              SUCC( X1 ), Y2, FColor );
  268.  
  269.    WriteCXY( Menu_Box_Chars.Bottom_Right_Corner, X2, Y2, FColor );
  270.  
  271. END   (* Draw_Box *);
  272.  
  273. (*----------------------------------------------------------------------*)
  274. (*                Draw_Menu_Frame --- Draw a Frame                      *)
  275. (*----------------------------------------------------------------------*)
  276.  
  277. PROCEDURE Draw_Menu_Frame( UpperLeftX,  UpperLeftY,
  278.                            LowerRightX, LowerRightY : INTEGER;
  279.                            Frame_Color, Title_Color,
  280.                            Text_Color               : INTEGER;
  281.                            Menu_Title: AnyStr );
  282.  
  283. (*----------------------------------------------------------------------*)
  284. (*                                                                      *)
  285. (*     Procedure:  Draw_Menu_Frame                                      *)
  286. (*                                                                      *)
  287. (*     Purpose:    Draws a titled frame using PC graphics characters    *)
  288. (*                                                                      *)
  289. (*     Calling Sequence:                                                *)
  290. (*                                                                      *)
  291. (*        Draw_Menu_Frame( UpperLeftX,  UpperLeftY,                     *)
  292. (*                         LowerRightX, LowerRightY,                    *)
  293. (*                         Frame_Color, Title_Color : INTEGER;          *)
  294. (*                         Menu_Title: AnyStr );                        *)
  295. (*                                                                      *)
  296. (*           UpperLeftX,  UpperLeftY  --- Upper left coordinates        *)
  297. (*           LowerRightX, LowerRightY --- Lower right coordinates       *)
  298. (*           Frame_Color              --- Color for frame               *)
  299. (*           Title_Color              --- Color for title text          *)
  300. (*           Text_Color               --- Color for interior text       *)
  301. (*           Menu_Title               --- Menu Title                    *)
  302. (*                                                                      *)
  303. (*     Calls:   GoToXY                                                  *)
  304. (*              Dupl                                                    *)
  305. (*              Draw_Box                                                *)
  306. (*              Do_Explosion (internal)                                 *)
  307. (*                                                                      *)
  308. (*     Remarks:                                                         *)
  309. (*                                                                      *)
  310. (*        The area inside the frame is cleared after the frame is       *)
  311. (*        drawn.  If a box without a title is desired, enter a null     *)
  312. (*        string for a title.                                           *)
  313. (*                                                                      *)
  314. (*----------------------------------------------------------------------*)
  315.  
  316. VAR
  317.    I  : INTEGER;
  318.    L  : INTEGER;
  319.    LT : INTEGER;
  320.    XM : INTEGER;
  321.    YM : INTEGER;
  322.    XS : INTEGER;
  323.    YS : INTEGER;
  324.    R  : REAL;
  325.    X1 : INTEGER;
  326.    X2 : INTEGER;
  327.    Y1 : INTEGER;
  328.    Y2 : INTEGER;
  329.    XM1: INTEGER;
  330.    YM1: INTEGER;
  331.    Knt: INTEGER;
  332.  
  333. (*----------------------------------------------------------------------*)
  334. (*               Do_Explosion --- Draw an 'exploding' box               *)
  335. (*----------------------------------------------------------------------*)
  336.  
  337. PROCEDURE Do_Explosion;
  338.  
  339. (*----------------------------------------------------------------------*)
  340. (*               --- Basic algorithm by Jim Everingham ---              *)
  341. (*----------------------------------------------------------------------*)
  342.  
  343. BEGIN (* Do_Explosion *)
  344.  
  345.    XM     := UpperLeftX + L SHR 1;
  346.    YM     := UpperLeftY + ( LowerRightY - UpperLeftY ) SHR 1;
  347.    X1     := UpperLeftX;
  348.    X2     := LowerRightX;
  349.    Y1     := UpperLeftY;
  350.    Y2     := LowerRightY;
  351.  
  352.    XM1    := XM;
  353.    YM1    := YM;
  354.                                     (* Figure out increments for *)
  355.                                     (* increasing boz dimensions *)
  356.                                     (* to produce explosion.     *)
  357.    IF ( XM > YM ) THEN
  358.        Knt    :=  L SHR 1
  359.    ELSE
  360.        Knt    := ( Y2 - Y1 ) SHR 1;
  361.  
  362.    Y1     := PRED( Y1 );
  363.    Y2     := PRED( Y2 );
  364.  
  365.    X1     := SUCC( X1 );
  366.    X2     := PRED( X2 );
  367.                                    (* Draw series of increasing     *)
  368.                                    (* size boxes, giving appearance *)
  369.                                    (* that box "explodes" from its  *)
  370.                                    (* center.                       *)
  371.  
  372.    FOR I := 1 TO ROUND( Knt / 3 ) DO
  373.       BEGIN
  374.                                    (* Adjust sides *)
  375.  
  376.          IF ( XM > ( X1 - 2 ) ) THEN
  377.             XM := XM - 3
  378.          ELSE IF ( XM > PRED( X1 ) ) THEN
  379.             XM := XM - 2
  380.          ELSE IF ( XM > X1 ) THEN
  381.             XM := PRED( XM );
  382.  
  383.          IF ( XM1 < ( X2 + 2 ) ) THEN
  384.             XM1 := XM1 + 3
  385.          ELSE IF ( XM1 < ( X2 + 1 ) ) THEN
  386.             XM1 := XM1 + 2
  387.          ELSE IF ( XM1 < X2 ) THEN
  388.             XM1 := SUCC( XM1 );
  389.                                    (* Adjust top and bottom *)
  390.  
  391.          IF ( YM > ( Y1 + 2 ) ) THEN
  392.             YM := YM - 3
  393.          ELSE IF ( YM > ( Y1 + 1 ) ) THEN
  394.             YM := YM - 2
  395.          ELSE IF ( YM > Y1 ) THEN
  396.             YM := PRED( YM );
  397.  
  398.          IF ( YM1 < ( Y2 - 2 ) ) THEN
  399.             YM1 := YM1 + 3
  400.          ELSE IF ( YM1 < PRED( Y2 ) ) THEN
  401.             YM1 := YM1 + 2
  402.          ELSE IF ( YM1 < Y2 ) THEN
  403.             YM1 := SUCC( YM1 );
  404.                                    (* Define new window *)
  405.  
  406.          WINDOW( SUCC( XM ), SUCC( YM ), XM1, YM1 );
  407.  
  408.                                    (* Clear it out      *)
  409.          Clear_Window;
  410.                                    (* Draw box          *)
  411.  
  412.          Draw_Box( SUCC( XM ), SUCC( YM ), MIN( LowerRightX , XM1 ),
  413.                    YM1, Frame_Color, Title_Color, '' );
  414.  
  415.       END (* FOR *);
  416.  
  417. END   (* Do_Explosion *);
  418.  
  419. (*----------------------------------------------------------------------*)
  420.  
  421. BEGIN (* Draw_Menu_Frame *)
  422.  
  423.    L  := LowerRightX - UpperLeftX;
  424.    LT := LENGTH( Menu_Title );
  425.                                    (* Adjust title length if necessary *)
  426.  
  427.    IF LT > ( L - 5 ) THEN Menu_Title[0] := CHR( L - 5 );
  428.  
  429.                                    (* Get explosion if requested *)
  430.  
  431.    IF Menu_Explode_Mode THEN Do_Explosion;
  432.  
  433.                                    (* Display actual menu frame       *)
  434.  
  435.    Draw_Box( UpperLeftX, UpperLeftY, LowerRightX, LowerRightY,
  436.              Frame_Color, Title_Color, Menu_Title );
  437.  
  438.                                    (* Establish scrolling window area *)
  439.  
  440.    Window( UpperLeftX+1, UpperLeftY+1, LowerRightX-1, LowerRightY-1 );
  441.  
  442.                                    (* Ensure proper color for text    *)
  443.    TextColor     ( Text_Color );
  444.    TextBackGround( BLACK );
  445.                                    (* Clear out the window area       *)
  446.                                    (* KLUDGE NOTE:  ClrScr doesn't    *)
  447.                                    (* seem to work correctly on mono  *)
  448.                                    (* screens with Turbo 3.0 in the   *)
  449.                                    (* context of PibTerm.             *)
  450. (*
  451.    ClrScr;
  452. *)
  453.    FOR I := 1 TO PRED( LowerRightY - UpperLeftY ) DO
  454.       BEGIN
  455.          GoToXY( 1 , I );
  456.          ClrEol;
  457.       END;
  458.  
  459.    GoToXY( 1 , 1 );
  460.  
  461. END   (* Draw_Menu_Frame *);
  462.  
  463. (*----------------------------------------------------------------------*)
  464. (*                Menu_Click --- Make short click noise                 *)
  465. (*----------------------------------------------------------------------*)
  466.  
  467. PROCEDURE Menu_Click;
  468.  
  469. (*----------------------------------------------------------------------*)
  470. (*                                                                      *)
  471. (*     Procedure:  Menu_Click                                           *)
  472. (*                                                                      *)
  473. (*     Purpose:    Clicks Terminal Bell                                 *)
  474. (*                                                                      *)
  475. (*     Calling Sequence:                                                *)
  476. (*                                                                      *)
  477. (*        Menu_Click;                                                   *)
  478. (*                                                                      *)
  479. (*     Calls:    Sound                                                  *)
  480. (*               Delay                                                  *)
  481. (*               NoSound                                                *)
  482. (*                                                                      *)
  483. (*----------------------------------------------------------------------*)
  484.  
  485. BEGIN (* Menu_Click *)
  486.  
  487.    IF Menu_Beep_Mode THEN
  488.       BEGIN
  489.          Sound( 2000 );
  490.          DELAY( 10 );
  491.          NoSound;
  492.       END;
  493.  
  494. END   (* Menu_Click *);
  495.  
  496. (*----------------------------------------------------------------------*)
  497. (*                Menu_Beep --- Ring Terminal Bell                      *)
  498. (*----------------------------------------------------------------------*)
  499.  
  500. PROCEDURE Menu_Beep;
  501.  
  502. (*----------------------------------------------------------------------*)
  503. (*                                                                      *)
  504. (*     Procedure:  Menu_Beep                                            *)
  505. (*                                                                      *)
  506. (*     Purpose:    Rings Terminal Bell                                  *)
  507. (*                                                                      *)
  508. (*     Calling Sequence:                                                *)
  509. (*                                                                      *)
  510. (*        Menu_Beep;                                                    *)
  511. (*                                                                      *)
  512. (*     Calls:    None                                                   *)
  513. (*                                                                      *)
  514. (*     Remarks:                                                         *)
  515. (*                                                                      *)
  516. (*        If Menu_Beep_Mode is FALSE, then '<ALERT>' is displayed in    *)
  517. (*        blinking characters on status line for 1 second               *)
  518. (*                                                                      *)
  519. (*----------------------------------------------------------------------*)
  520.  
  521. VAR
  522.    I        : INTEGER;
  523.    J        : INTEGER;
  524.    Save_C25 : PACKED ARRAY[1..7] OF CHAR;
  525.    Save_A25 : PACKED ARRAY[1..7] OF BYTE;
  526.  
  527. BEGIN (* Menu_Beep *)
  528.                                    (* Generate beep if beep mode on *)
  529.    IF Menu_Beep_Mode THEN
  530.       WRITE( Ch_Bell )
  531.    ELSE                            (* Else generate blinking error  *)
  532.       BEGIN
  533.                                    (* Save character, attribute *)
  534.          FOR I := 1 TO 7 DO
  535.              ReadCXY( Save_C25[I], ( 35 + I ), Max_Screen_Line, Save_A25[I] );
  536.  
  537.                                    (* Display blinking error indicator *)
  538.  
  539.          WriteSXY( '<ALERT>', 36, Max_Screen_Line, WHITE + BLINK );
  540.  
  541.          DELAY( One_Second_Delay );
  542.  
  543.                                    (* Restore previous text *)
  544.          FOR I := 1 TO 7 DO
  545.             WriteCXY( Save_C25[I], ( 35 + I ), Max_Screen_Line, Save_A25[I] );
  546.  
  547.       END;
  548.  
  549. END   (* Menu_Beep *);
  550.  
  551. (*----------------------------------------------------------------------*)
  552. (*                Menu_Turn_On --- Highlight Menu Choice                *)
  553. (*----------------------------------------------------------------------*)
  554.  
  555. PROCEDURE Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );
  556.  
  557. (*----------------------------------------------------------------------*)
  558. (*                                                                      *)
  559. (*     Procedure:  Menu_Turn_On                                         *)
  560. (*                                                                      *)
  561. (*     Purpose:    Highlight a menu item using reverse video            *)
  562. (*                                                                      *)
  563. (*     Calling Sequence:                                                *)
  564. (*                                                                      *)
  565. (*        Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );         *)
  566. (*                                                                      *)
  567. (*           Menu      : Menu containing item to highlight              *)
  568. (*           Menu_Item : Menu entry to highlight                        *)
  569. (*                                                                      *)
  570. (*     Calls:    GoToXY                                                 *)
  571. (*               RvsVideoOn                                             *)
  572. (*               RvsVideoOff                                            *)
  573. (*                                                                      *)
  574. (*----------------------------------------------------------------------*)
  575.  
  576. BEGIN (* Menu_Turn_On *)
  577.  
  578.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  579.       BEGIN
  580.  
  581.          GoToXY( Menu_Item_Column, Menu_Item_Row );
  582.  
  583.          TextColor     ( Menu.Menu_Bcolor );
  584.          TextBackGround( Menu.Menu_Tcolor );
  585.  
  586.          WRITE( Menu_Item_Text );
  587.  
  588.          TextColor     ( Menu.Menu_Tcolor );
  589.          TextBackGround( Menu.Menu_Bcolor );
  590.  
  591.       END;
  592.  
  593. END   (* Menu_Turn_On *);
  594.  
  595. (*----------------------------------------------------------------------*)
  596. (*                Menu_Turn_Off --- UnHighlight Menu Choice             *)
  597. (*----------------------------------------------------------------------*)
  598.  
  599. PROCEDURE Menu_Turn_Off( Menu: Menu_Type; Menu_Item : INTEGER );
  600.  
  601. (*----------------------------------------------------------------------*)
  602. (*                                                                      *)
  603. (*     Procedure:  Menu_Turn_Off                                        *)
  604. (*                                                                      *)
  605. (*     Purpose:    Removes highlighting from menu item                  *)
  606. (*                                                                      *)
  607. (*     Calling Sequence:                                                *)
  608. (*                                                                      *)
  609. (*        Menu_Turn_Off( Menu : Menu_Type; Menu_Item : INTEGER );       *)
  610. (*                                                                      *)
  611. (*           Menu        : Menu containing item to unhighlight          *)
  612. (*           RvsVideoOff : Menu entry to un-highlight                   *)
  613. (*                                                                      *)
  614. (*     Calls:    GoToXY                                                 *)
  615. (*                                                                      *)
  616. (*----------------------------------------------------------------------*)
  617.  
  618. BEGIN (* Menu_Turn_Off *)
  619.  
  620.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  621.       BEGIN
  622.  
  623.          GoToXY( Menu_Item_Column , Menu_Item_Row );
  624.  
  625.          TextColor     ( Menu.Menu_TColor );
  626.          TextBackGround( Menu.Menu_BColor );
  627.  
  628.          WRITE( Menu_Item_Text );
  629.  
  630.       END;
  631.  
  632. END   (* Menu_Turn_Off *);
  633.  
  634. (*----------------------------------------------------------------------*)
  635. (*                Menu_IBMCh --- Interpret IBM keyboard chars.          *)
  636. (*----------------------------------------------------------------------*)
  637.  
  638. PROCEDURE Menu_IBMCh( VAR C : CHAR );
  639.  
  640. (*----------------------------------------------------------------------*)
  641. (*                                                                      *)
  642. (*     Procedure:  Menu_IBMCh                                           *)
  643. (*                                                                      *)
  644. (*     Purpose:    Interpret IBM keyboard chars.                        *)
  645. (*                                                                      *)
  646. (*     Calling Sequence:                                                *)
  647. (*                                                                      *)
  648. (*        Menu_IBMCh( Var C : Char );                                   *)
  649. (*                                                                      *)
  650. (*           C --- On input, char following escape;                     *)
  651. (*                 on output, char revised to Wordstar command code.    *)
  652. (*                                                                      *)
  653. (*     Calls:   Read_Kbd                                                *)
  654. (*                                                                      *)
  655. (*----------------------------------------------------------------------*)
  656.  
  657. BEGIN  (* Menu_IBMCh *)
  658.  
  659.    Read_Kbd( C );
  660.  
  661.    CASE C OF
  662.  
  663.       'H'   : C := Up_arrow;
  664.       'P'   : C := Down_arrow;
  665.       ELSE
  666.               C := CHR( ESC );
  667.  
  668.    END;
  669.  
  670. END   (* Menu_IBMCh *);
  671.  
  672. (*----------------------------------------------------------------------*)
  673. (*                Menu_Display_Choices --- Display Menu Choices         *)
  674. (*----------------------------------------------------------------------*)
  675.  
  676. PROCEDURE Menu_Display_Choices( Menu : Menu_Type );
  677.  
  678. (*----------------------------------------------------------------------*)
  679. (*                                                                      *)
  680. (*     Procedure:  Menu_Display_Choices                                 *)
  681. (*                                                                      *)
  682. (*     Purpose:    Displays Menu Choices                                *)
  683. (*                                                                      *)
  684. (*     Calling Sequence:                                                *)
  685. (*                                                                      *)
  686. (*        Menu_Display_Choices( Menu : Menu_Type );                     *)
  687. (*                                                                      *)
  688. (*           Menu --- Menu record to be displayed.                      *)
  689. (*                                                                      *)
  690. (*     Calls:   ClsScr                                                  *)
  691. (*              GoToXY                                                  *)
  692. (*              Draw_Menu_Frame                                         *)
  693. (*              Save_Screen                                             *)
  694. (*                                                                      *)
  695. (*----------------------------------------------------------------------*)
  696.  
  697. VAR
  698.    I    : INTEGER;
  699.    J    : INTEGER;
  700.    XL   : INTEGER;
  701.    YL   : INTEGER;
  702.    XR   : INTEGER;
  703.    YR   : INTEGER;
  704.    MaxX : INTEGER;
  705.    MaxY : INTEGER;
  706.  
  707. BEGIN (* Menu_Display_Choices *)
  708.  
  709.                                    (* Establish menu size *)
  710.    XL := Menu.Menu_Column;
  711.    YL := Menu.Menu_Row;
  712.  
  713.    XR := PRED( LENGTH( Menu.Menu_Title ) + XL );
  714.    YR := YL;
  715.  
  716.    MaxX := MAX( Menu.Menu_Width , ( LENGTH( Menu.Menu_Title ) + 2 ) );
  717.    MaxY := Menu.Menu_Height;
  718.  
  719.    FOR I := 1 TO Menu.Menu_Size DO
  720.       WITH Menu.Menu_Entries[I] DO
  721.       BEGIN
  722.          IF Menu_Item_Row > MaxY THEN MaxY := Menu_Item_Row;
  723.          J := PRED( LENGTH( Menu_Item_Text ) + Menu_Item_Column );
  724.          IF J > MaxX THEN MaxX := J;
  725.       END;
  726.  
  727.    J := PRED( XL + MaxX );
  728.    IF J > XR THEN XR := J;
  729.  
  730.    J := PRED( YL + MaxY );
  731.    IF J > YR THEN YR := J;
  732.  
  733.    XL := XL - 4;
  734.    IF XL < 0 THEN XL := 0;
  735.  
  736.    YL := PRED( YL );
  737.    IF YL < 0 THEN YL := 0;
  738.  
  739.    YR := SUCC( YR );
  740.    IF YR > Max_Screen_Line THEN YR := Max_Screen_Line;
  741.  
  742.    IF XR > Max_Screen_Col THEN XR := Max_Screen_Col;
  743.  
  744.                                    (* Save current screen image *)
  745.                                    (* if not already saved      *)
  746.  
  747.    IF Current_Saved_Screen > 0 THEN
  748.       BEGIN
  749.          IF Saved_Screen_List[ Current_Saved_Screen ] <> Saved_Screen THEN
  750.             Save_Partial_Screen( Saved_Screen, XL, YL, XR, YR );
  751.       END
  752.    ELSE
  753.       Save_Partial_Screen( Saved_Screen, XL, YL, XR, YR );
  754.  
  755.                                    (* Draw the menu frame       *)
  756.  
  757.    Draw_Menu_Frame( XL, YL, XR, YR, Menu.Menu_FColor, Menu.Menu_HColor,
  758.                     Menu.Menu_TColor, Menu.Menu_Title );
  759.  
  760.                                    (* Display Menu Entries *)
  761.  
  762.    FOR I := 1 TO Menu.Menu_Size DO
  763.       WITH Menu.Menu_Entries[I] DO
  764.          BEGIN
  765.             GoToXY( Menu_Item_Column , Menu_Item_Row );
  766.             WRITE( Menu_Item_Text );
  767.          END;
  768.                                    (* Highlight Default Choice *)
  769.  
  770.    Menu_Turn_On( Menu, Menu.Menu_Default );
  771.  
  772. END   (* Menu_Display_Choices *);
  773.  
  774. (*----------------------------------------------------------------------*)
  775. (*                Menu_Get_Choice --- Get Menu Choice                   *)
  776. (*----------------------------------------------------------------------*)
  777.  
  778. FUNCTION Menu_Get_Choice( Menu: Menu_Type; Erase_After: BOOLEAN ) : INTEGER;
  779.  
  780. (*----------------------------------------------------------------------*)
  781. (*                                                                      *)
  782. (*     Function:  Menu_Get_Choice                                       *)
  783. (*                                                                      *)
  784. (*     Purpose:   Retrieves Menu Choice from current menu               *)
  785. (*                                                                      *)
  786. (*     Calling Sequence:                                                *)
  787. (*                                                                      *)
  788. (*        Ichoice := Menu_Get_Choice( Menu       : Menu_Type;           *)
  789. (*                                    Erase_After: BOOLEAN ) : INTEGER; *)
  790. (*                                                                      *)
  791. (*           Menu        --- Currently displayed menu                   *)
  792. (*           Erase_After --- TRUE to erase menu after choice found      *)
  793. (*           Ichoice     --- Returned menu item chosen                  *)
  794. (*                                                                      *)
  795. (*      Calls:   Menu_Click                                             *)
  796. (*               Menu_IBMCh                                             *)
  797. (*               Menu_Turn_Off                                          *)
  798. (*               Menu_Turn_On                                           *)
  799. (*                                                                      *)
  800. (*      Remarks:                                                        *)
  801. (*                                                                      *)
  802. (*         The current menu item is highlighted in reverse video.       *)
  803. (*         It may be chosen by hitting the return key.  Movement        *)
  804. (*         to other menu items is done using the up-arrow and           *)
  805. (*         down-arrow.                                                  *)
  806. (*                                                                      *)
  807. (*         An item may also be chosen by hitting the first character    *)
  808. (*         of that item.                                                *)
  809. (*                                                                      *)
  810. (*----------------------------------------------------------------------*)
  811.  
  812. VAR
  813.    C       : CHAR;
  814.    Current : INTEGER;
  815.    Last    : INTEGER;
  816.    I       : INTEGER;
  817.    Found   : BOOLEAN;
  818.  
  819. BEGIN  (* Menu_Get_Choice *)
  820.                                    (* Increase menu depth *)
  821.  
  822.    Menu_Depth := SUCC( Menu_Depth );
  823.  
  824.                                    (* Get default *)
  825.    Current := Menu.Menu_Default;
  826.  
  827.    Last    := PRED( Current );
  828.    IF Last < 1 THEN Last := Menu.Menu_Size;
  829.  
  830.    REPEAT  (* Loop until return key hit *)
  831.  
  832.                                    (* Read a character *)
  833.       Read_Kbd( C );
  834.       Menu_Click;
  835.  
  836.       C := UpCase( C );
  837.                                    (* Convert character to menu code *)
  838.  
  839.       IF ( C = Ch_Esc ) AND KeyPressed THEN
  840.          Menu_IBMCh( C );
  841.                                    (* Process character *)
  842.       CASE C OF
  843.  
  844.          Down_arrow,
  845.          Space_bar     : BEGIN (* Move down menu *)
  846.                             Last    := Current;
  847.                             Current := SUCC( Current );
  848.                             IF Current > Menu.Menu_Size THEN
  849.                                Current := 1;
  850.                          END;
  851.  
  852.          Up_arrow      : BEGIN (* Move up menu *)
  853.                             Last    := Current;
  854.                             Current := PRED( Current );
  855.                             IF Current < 1 THEN
  856.                                Current := Menu.Menu_Size;
  857.                          END   (* Move up menu *);
  858.  
  859.          Ch_Cr         : ;
  860.  
  861.          Ch_Esc        : Current := -1;
  862.  
  863.          ELSE
  864.  
  865.             Found := FALSE;
  866.  
  867.             FOR I := 1 TO Menu.Menu_Size DO
  868.                IF C = UpCase( Menu.Menu_Entries[I].Menu_Item_Text[1] ) THEN
  869.                   BEGIN
  870.                      Found   := TRUE;
  871.                      C       := Ch_Cr;
  872.                      Last    := Current;
  873.                      Current := I;
  874.                   END;
  875.  
  876.             IF ( NOT Found ) THEN Menu_Beep;
  877.  
  878.       END (* CASE *);
  879.                                    (* Highlight new menu choice *)
  880.  
  881.       IF C IN [ Up_arrow, Down_arrow, Space_bar, Ch_Cr ] THEN
  882.          BEGIN
  883.             Menu_Turn_Off( Menu, Last    );
  884.             Menu_Turn_On ( Menu, Current );
  885.          END;
  886.  
  887.    UNTIL ( C = Ch_CR ) OR ( C = Ch_Esc );
  888.  
  889.                                    (* Return index of chosen value *)
  890.    Menu_Get_Choice := Current;
  891.  
  892.                                    (* Erase menu from display      *)
  893.    IF Erase_After THEN
  894.       BEGIN                        (* Restore previous screen      *)
  895.  
  896.          Restore_Screen( Saved_Screen );
  897.  
  898.                                    (* Restore global colors        *)
  899.          Reset_Global_Colors;
  900.  
  901.       END;
  902.                                    (* Decrease menu depth *)
  903.  
  904.    Menu_Depth := MAX( PRED( Menu_Depth ) , 0 );
  905.  
  906. END   (* Menu_Get_Choice *);
  907.